The goal of this document is to estimate the real number of infections in portugal (not the confirmed cases of infection) usign the number of deaths and other parameters, like: - Death Rate - \(R_0\) - Infection Rate - Transmission rate - Variation over time of the \(R\) as a side effect of Public Health Measures

Estimating the number of infeccious individuals given the number of deaths

It can be said that if the death rate is (for example) 5%, and: - If the time between exposition onset (the day in which the person got the virus, but it is still not infected) and the individual to became infeccious is 5 days - If from that point on, for a death to occur it takes 15 days - We know that at a given day, there was 1 death

In this setup, we can extrapolate that 20 days before the death, there was 20 infected - from which 1 individual died 20 days after. Now, in that day 20 days ago, the individuals are not aware that they are infected - because no symptoms are shown.

To continue the simulation, let’s estimate the \(R_0\) with the current confirmed cases in portugal

Estimating the \(R_0\) with confirmed cases

library(incidence)
library(earlyR)

incidences <- c()
incidences <- c(incidences, rep("2020-3-2", 2))
incidences <- c(incidences, rep("2020-3-3", 0))
incidences <- c(incidences, rep("2020-3-4", 3))
incidences <- c(incidences, rep("2020-3-5", 3))
incidences <- c(incidences, rep("2020-3-6", 5))
incidences <- c(incidences, rep("2020-3-7", 7))
incidences <- c(incidences, rep("2020-3-8", 10))
incidences <- c(incidences, rep("2020-3-9", 0))
incidences <- c(incidences, rep("2020-3-10", 11))
incidences <- c(incidences, rep("2020-3-11", 18))
incidences <- c(incidences, rep("2020-3-12", 0))
incidences <- c(incidences, rep("2020-3-13", 53))
incidences <- c(incidences, rep("2020-3-14", 57))
incidences <- c(incidences, rep("2020-3-15", 76))
incidences <- c(incidences, rep("2020-3-16", 86))
incidences <- c(incidences, rep("2020-3-17", 117))

today <- as.Date("2020-03-18")
incidence_obj <- incidence(as.Date(incidences), last_date = today)
mu <- 8 # mean days for a person to be infectious and with simptoms 
sigma <- 3.4 # standard deviation in days
base_R_stats <- get_R(incidence_obj, si_mean = mu, si_sd = sigma)
## Warning: 'EpiEstim::OverallInfectivity' is deprecated.
## Use 'overall_infectivity' instead.
## See help("Deprecated")
plot(base_R_stats)

R_val <- sample_R(base_R_stats, 1000)
summary(R_val) # basic stats
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   2.472   2.793   2.883   2.887   2.983   3.544
hist(R_val, border = "grey", col = "navy",
     xlab = "Values of R",
     main = "Sample of likely R values")

plot(base_R_stats, "lambdas", scale = length(incidences) + 1)
abline(v = incidences, lwd = 3, col = "grey")
## Warning in int_abline(a = a, b = b, h = h, v = v, untf = untf, ...): NAs introduced by coercion
abline(v = today, col = "blue", lty = 2, lwd = 2)
points(incidences, seq_along(incidences), pch = 20, cex = 3)
## Warning in xy.coords(x, y): NAs introduced by coercion

pt_incidence_fit <- incidence::fit(incidence_obj, split = NULL)
## Warning in incidence::fit(incidence_obj, split = NULL): 4 dates with incidence of 0 ignored for fitting
plotly::ggplotly(plot(pt_incidence_fit))

So, assuming a \(R_0\) of 3.1 and a factor of 20 of exposing individuals (meaning that the inicial 20 infected individuals generated 400 exposed individuals at time 0), let’s do a simulation using the SEIR Model

r0_changes_over_time = list(
  #list()
  #list("15" = 5.1, "20" = 4.5, "25" = 3, "40" = 0.7)
  list("20" = 2.1, "25" = 1.5, "35" = 1., "45" = 0.7)
)
r0_changes_over_time_labels = c("Moderate Isolation Measures")

portuguese_population = 10283822 
portuguese_population_older_than_60_percentage = 0.23
# https://www.pordata.pt/Portugal/Popula%C3%A7%C3%A3o+residente++m%C3%A9dia+anual+total+e+por+grupo+et%C3%A1rio-10
portuguese_intensive_care_beds_entire_population = portuguese_population*4.2/100000
# https://link.springer.com/article/10.1007/s00134-012-2627-8 , Fig 1
portuguese_initial_infectious_individuals = 20
portuguese_amount_of_days = 30 * 2 # six months
portuguese_start_date = "2020-02-28"
r0 = 2.8
  

portugal_simulation = simulation_with_r0_changes_over_time(
  total_population = portuguese_population,
  intensive_care_beds = portuguese_intensive_care_beds_entire_population,
  initial_infectious_individuals = portuguese_initial_infectious_individuals,
  initial_exposed_individuals_factor = 20,
  r0 = r0 ,
  amount_of_days = portuguese_amount_of_days,
  start_date = portuguese_start_date,
  collection_of_r0_changes_over_time = r0_changes_over_time,
  collection_of_r0_changes_over_time_labels = r0_changes_over_time_labels
)

seir_model_with_deaths_generated_data = portugal_simulation[[1]]

plotly::plot_ly(seir_model_with_deaths_generated_data, x = ~days) %>%
  plotly::add_lines(y = ~susceptible_individuals, name = "Susceptible", line = list(color = "black")) %>%
  plotly::add_lines(y = ~exposed_individuals, name = "Exposed", line = list(color = "blue")) %>%
  plotly::add_lines(y = ~infectious_individuals, name="Infectious",line = list(color = "orange")) %>%
  plotly::add_lines(y = ~recovered_individuals, name="Recovered",line = list(color = "green")) %>%
  plotly::add_lines(y = ~dead_individuals, name="Death",line = list(color = "red"))  
  #plotly::layout(yaxis = list(type = "log"))